perm filename S2.F4[LX,LCS]2 blob sn#166764 filedate 1975-07-02 generic text, type T, neo UTF8
00100		SUBROUTINE READIT
00200		COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
00300		1 LN,ITYP,TPALN(4),JED
00400	CC 7/74 COLGATE  COMMON/TYP/ IS FOR COLTTY ROUT.
00500		COMMON/A/ V(2000),ROFF(27),NP(27),PCH(27,32),
00600		1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
00700		1 ,P1(27),JFM(4),COPY(30),IFM(80)
00800		1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
00900		DIMENSION IV(2000),LIST(78),JNP(80)
01000	C   WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY 
01100	C   40 LIT CHARS + 30 PARAMS PER INST.
01200	C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.
01300		COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
01400		1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
01500		1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
01600		COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
01700		1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
01800		1 ZZ,CHN,YY 
01900		1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
02000		1  /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
02100		1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
02200		1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
02300	C  /C/=26
02400		EQUIVALENCE (VX1,VX(1)),(JNP,INP1,INP(1)),(IPP,ISCA(2))
02500		1 ,(ISS,ISCA(9)),(ITT,ISCA(11))
02600		1 ,(IE,ISCA(5)),(ID,ISCA(3)),(IF,ISCA(6)),(IAA,ISCA(10))
02700		1 ,(VX2,VX(2)),(VX3,VX(3)),(VX4,VX(4)),(IDOT,IDAT(11))
02800		1 ,(V,IV),(LIST,IFM(3)),(IG,ISCA(8))
02900	C   *************** READS INPUT  ***********************
03000	2308	IF(ITYP)GO TO 2127
03100		DATA TINST /25H(' TYPE INST NAME, ETC'/)/,KSLA/'/'/
03200		1,TEDIT/20H(' RETYPE LINE?'/  )/,IEN/'N'/,ITMPO/'TEMPO'/
03300	23081	TYPE TINST
03400		ACCEPT 77732,JNP
03500	77732	FORMAT(80A1)
03600	CC	IF(JED)WRITE(21,77732)INP
03700		IF(JED)CALL COLTTY(JNP,21)
03800		JFM(4)='80A1)'
03900	C  PUTS ON LPT AND TTY
04000		GO TO 1074
04100	CC 6/74 COLGATE2127	JREAD=1
04200	CC 6/74 COLGATE 4400	READ(1,77732,END=2337)JNP
04300	2127	IF(READER(JNP))CALL RUNIT
04400	C  READS A LINE.  IF END OF FILE, JUMPS.
04500	CC  SEE END OF PG.6	IF(SOS)WRITE(JOUT,87732)INP
04600	CC 7/74	IF(SOS)CALL COLTTY(JNP,JOUT,3)
04700	CC 6/74  COLGATE 	GO TO(441,442,443,444,445,446)JREAD
04800	
04900	441	JFM(4)='80A1)'
05000		IF(LN.EQ.0)GO TO 1074
05100	CC	REREAD 2114,LN,JNP
05200	C****  READS ONLY FILES WITH LINE NUMBERS!
05300		JFM(1)=' (I,A'
05400		CALL FMT(JFM,JNP,MLX)
05500		REREAD JFM,LN,J,JNP
05600		GO TO 4127
05700	1074	JFM(1)='   (A'
05800		CALL FMT(JFM,JNP,MLX)
05900		REREAD JFM,J,JNP
06000	4127	IF(JED)GO TO 41271
06100		IF(K.EQ.'Y')GO TO 41271
06200	C  K CHECK IS TO PASS AFTER RETYPING
06300		TYPE TEDIT
06400		ACCEPT 77732,K
06500		IF(K.EQ.'Y')GO TO 23081
06600		IF(K.EQ.IG)JED=-1
06700	
06800	
06900	41271	IF(J.EQ.IBLA)GO TO 2308
07000		MLX=1
07100		IZ=0
07200		JA=-1
07300		ISUB=4
07400		CALL CLEAN(INP,LEND)
07500	C  CLEANS OUT = AND , AND FINDS LINE LENGTH.
07600		ALL=1.
07700		VX1=0
07800		VX2=0
07900		VX3=0
08000		LK=-1
08100		K=0
08200		IF(V(I-1).NE.-9900.-BY)GO TO 364
08300		BY=-1.
08400		I=I-1
08500	364	DO 361 JD=1,LEND
08600		N=INP(JD)
08700		IF(N.NE.'R')GO TO 361
08800	C  LOOKS FOR 'RESTART'
08900		DO 3611 M=JD,LEND
09000		KL=INP(M)
09100		IF(KL.EQ.IBLA)GO TO 3631
09200		IF(KL.EQ.ISEMI)GO TO 3631
09300	CCZZZ IF(KL.EQ.IBLA.OR.KL.EQ.ISEMI.OR.KL.EQ.KSLA.OR.KL.EQ.',')GO TO 3631
09400	3611	INP(M)=IBLA
09500	C   CHANGES 'RESTART' TO BLANKS
09600	3631	DO 363 N=1,NINS
09700		IF(J.NE.INST(N))GO TO 363
09800		IQ(N)=-1
09900	C   SETS RESTART FLAG.  THIS INST WILL NOW APPEAR WITH NEW NUM.
10000		GO TO 362
10100	363	CONTINUE
10200	361	IF(N.EQ.ISEMI)GO TO 6773
10300	6773	K=K+1
10400		IF(K.GT.NINS)GO TO 36
10500		IF(INST(K).NE.J)GO TO 6773
10600		IF(IQ(K).EQ.-1)GO TO 6773
10700	C   FINDS CORRECT INST NUM.  PASSES RESTARTED INSTS.
10800		LK=K
10900		GO TO 1773
11000	36	IF(J.EQ.'RUN;')GO TO 197
11100		IF(J.NE.'RUN')GO TO 97
11200	197	CALL RUNIT
11300	97	IF(J.EQ.'INSER')GO TO 397
11400		IF(J.NE.'EDIT')GO TO 297
11500	397	ISUB=6  
11600	297	IF(ISUB.GT.4)GO TO 1773
11700		IF(J.EQ.ITMPO)GO TO 1773
11800		IF(J.EQ.'CONDU')GO TO 1773
11900		IF(J.EQ.'PLAY')GO TO 1773
12000		IF(J.EQ.'SECTI')GO TO 1081
12100	C******************  ABOVE AND BELOW FOR 'SECTIONS'
12200		IF(J.EQ.'END')GO TO 1082
12300		IF(J.EQ.'END S')GO TO 1082
12400		IF(J.EQ.'FINIS')GO TO 1082
12500	362	LK=NINS+1
12600		IF(LK.GT.KZY)GO TO 99
12700		INST(LK)=J
12800		IZ=LK
12900		GO TO 1773
13000	
13100	C*********** DOWN TO 99 FOR 'SECTIONS'
13200	1083	V(I)=-99.
13300		KL=1
13400		GO TO 3083
13500	C  READS 'PLAY SECT. N1,N2'
13600	1081	V(I)=-199.
13700		KL=4
13800	3083	DO 2081 K=KL,72
13900	C******  OR 80 ↑↑↑↑↑↑↑↑↑ ?????
14000		IF(INP(K).EQ.IBLA)GO TO 2081
14100		IV(I+1)=INP(K)
14200		I=I+2
14300	3081	BY=-1.
14400		GO TO 2308
14500	2081	CONTINUE
14600	C   READS SECTION IDENTIFIER, -199. MARKS BEGINNING
14700	C1082	IF(V(I-1).EQ.-9900.-BY)I=I-1
14800	C********* FEB 15,71
14900	1082	V(I)=-299.
15000		I=I+1
15100		GO TO 3081
15200	C   MARKS END OF SECTION
15300	C************************
15400	
15500	99	TYPE 199,LN
15600		STOP
15700	8001	FORMAT(A5,5F)
15800	107	FORMAT(I,A5,5F)
15900	199	FORMAT(' ERROR!!  LAST LINE READ =',I6/)
16000	4	IF(LK.LE.NINS)GO TO 8773
16100		IF(ALL.GT.0)GO TO 1004
16200		IF(IDALL.GT.0)GO TO 8773
16300		BG(LK)=VX1
16400		IDALL=LK
16500		GO TO 2004
16600	C 'MOVE' CHANGES IN 'ALINS' CAN'T BE RESET IN INDIV. INSTS.
16700	1004	BG(LK)=VX1
16800		IF(LK.EQ.IZ)VX1=0
16900	C   MAY 3,71 **** ALL PARAMS WILL BE SET UP AT TIME 0.
17000	C   CHECK EFFECT ON 'MOVE'!
17100	C ******** APR.23, 1971  FIXES BG TIMES IN 'MOVE'?????!!!!!!!
17200	2004	NINS=LK
17300		IF(VX3.NE.0)VX2=10000.+VX3
17400		IF(VX2.EQ.0)VX2=-1
17500		DUR(LK)=VX2
17600		GO TO 900
17700	C******** ABOVE FOR REST ONLY ENTRIES.  FEB 18,71
17800	8773	IF(VX2.NE.0)VX1=VX1*10000.+VX2
17900	900	IF(VX1.NE.BY)GO TO 497
18000		IF(J.NE.'PLAY')GO TO 5773
18100	C*********** 'PLAY' IS FOR 'SECTIONS'
18200	497	BY=VX1
18300	C  BY=CURRENT BG TIME.
18400		V(I)=-9900.-BY
18500		I=I+1
18600		IF(NWZ.NE.0)CALL BGSORT(BY)
18700	5773	IF(J.EQ.ITMPO)GO TO 1106
18800		IF(J.EQ.'CONDU')GO TO 3018
18900		IF(J.EQ.'PLAY')GO TO 1083
19000	C*********** ABOVE FOR 'SECTIONS'
19100	
19200	
19300	4773	NW=LPAR
19400	CZZZZZZZ	MLX=ML
19500		ML=MLX
19600		IF(I.GT.1900)TYPE 107,I
19700		ALL=1.
19800		DF=0
19900		ISUB=1
20000		IF(MLX.LT.LEND)GO TO 17732
20100		GO TO 7773
20200	CZZZZZZZZZZZZZZZZZZZZZZZZ
20300	1299	IF(MLX.LE.LEND)GO TO 1773
20400	CZZZZZZZZZZZZZZZ .LT. ZZZZZZZZZZZZ
20500	CC1299	IF(JZ.NE.0)GO TO 2773
20600	
20700	
20800	7773	IF(READER(JNP))CALL RUNIT
20900	C  READS A LINE.  IF END OF FILE, JUMPS.
21000	CC442	IF(LN.NE.0)REREAD 2114,LN,INP
21100		IF(INP1.EQ.IBLA)GO TO 7773
21200		IF(JED)GO TO 77733
21300		TYPE TEDIT
21400		ACCEPT 77732,K
21500		IF(K.NE.'Y')GO TO 442
21600		TYPE TPALN
21700		ACCEPT 77732,JNP
21800	442	IF(K.EQ.IG)JED=-1
21900	C   DOESN'T WORK FOR EDITS AND INSERTS YET???
22000	
22100	
22200	77733	MLX=1
22300	C  FOR CONTINUATION LINES.(CAN'T 'CONTINUE' TWICE IN A ROW!!)
22400	C   'LISTS' MUST END WITH ; IN NEW(7/74) VERSION. 
22500		CALL CLEAN(INP,LEND)
22600	CC2773	CALL CLEAN(INP,LEND)
22700	1773	IF(IPRN.EQ.0)GO TO 17732
22800		L=I-1
22900		IF(QTS.GE.0)GO TO 597
23000		IF(V(I-1).EQ.999.)L=L-1
23100	597	IPRN=IPRN-1
23200		IF(PARENS.EQ.0)GO TO 17733
23300		PARENS=0
23400		LIST(LCNT+2)=L
23500		LCNT=LCNT+3
23600		IF(IPRN.EQ.0)GO TO 17732
23700		IPRN=0
23800	17733	LIST(MOT)=L
23900		MOT=0
24000	C   FOR ERROR TRAP
24100	
24200	CC17732	JZ=0
24300	17732	N=0
24400	17731	ML=MLX
24500	
24600	C   BIG LOOP -- TO END OF PAGE 1.
24700		JD=ML
24800	975	N=INP(JD)
24900		IF(N.EQ.IBLA)GO TO 236
25000	CCZZZ	IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 236
25100	C ((((())))) MAY 13,71 /Z (D4/E/X 2 3)/ CS/ ETC.  CAN USE 26 LABELS.
25200	33611	IF(N.EQ.'(')GO TO 697
25300		IF(N.NE.')')GO TO 2361
25400	697	INP(JD)=IBLA
25500		L=JD-1
25600	5113	IF(INP(L).NE.IBLA)GO TO 2113
25700		L=L-1
25800		GO TO 5113
25900	2113	IF(N.EQ.')')GO TO 3361
26000		IF(PARENS.EQ.0)GO TO 1140
26100		LCNT=LCNT+3
26200		IF(MOT.NE.0)GO TO 11403
26300		MOT=LCNT-1
26400	1140	DO 11401 JC=1,LCNT-1,3
26500		IF(INP(L).NE.LIST(JC))GO TO 11401
26600	C  FINDS DUPLICATE IDENTIFIER
26700		TYPE 11402,INP(L)
26800		GO TO 99
26900	11403	TYPE 11404
27000		GO TO 99
27100	11404	FORMAT(' MORE THAN 2 PARENS OPEN'/)
27200	
27300	11402	FORMAT(' MOTIVIC (',A1,') USED TWICE')
27400	11401	CONTINUE
27500		LIST(LCNT)=INP(L)
27600		PARENS=-1.
27700		INP(L)=IBLA
27800		LIST(LCNT+1)=I
27900		GO TO 236
28000	C ''''''' FOR SINGLE QUOTES
28100	3361	IPRN=IPRN+1
28200		GO TO 236
28300	C  JUMPS BACK INTO QUOTE SECTION
28400	CQ	IF(PARENS.EQ.0)GO TO 2140
28500	CQ	LIST(LCNT+2)=L
28600	CQ	LCNT=LCNT+3
28700	CQ	PARENS=0
28800	CQ	GO TO 33612
28900	CQ2140	LIST(MOT)=L
29000	CQ	GO TO 33612
29100	CQC )))))))))))  LAST ) CAN'T APPEAR AT END OF LINE!!
29200	C @@@@@@@@@@@@ /@Z/DS3/ ETC. 
29300	2361	IF(N.NE.'@')GO TO 5361
29400		DO 113 L=1,LEND
29500		K=JD+L
29600	C   K IS USED AT 240!!!
29700		JG=INP(K)
29800		IF(JG.NE.'-')GO TO 6113
29900		RETRO=0
30000		INP(K)=IBLA
30100		GO TO 113
30200	6113	IF(JG.NE.'$')GO TO 7113
30300	C  '$' IS FOR INVERSIONS IN 'NOTES'
30400		INVRT=0
30500		GO TO 113
30600	7113	IF(JG.NE.IBLA)GO TO 4113
30700	113	CONTINUE
30800	4113	DO 6361 L=1,LCNT,3
30900		IF(JG.NE.LIST(L))GO TO 6361
31000		VX1=0
31100		DO 40 M=JD+2,LEND
31200		JG=INP(M)
31300		IF(JG.EQ.IBLA)GO TO 40
31400	CCZZZ	IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI.OR.JG.EQ.'*')GO TO 140
31500		IF(JG.EQ.KSLA)GO TO 140
31600		IF(JG.EQ.ISEMI)GO TO 140
31700		ML=M
31800		GO TO 240
31900	40	CONTINUE
32000	240	JC=JA
32100		JA=-1
32200		INP(K)=IBLA
32300		CALL SCANR
32400		JA=JC
32500	140	JC=1
32600		KN=LIST(L+1)
32700		M=LIST(L+2)+1
32800		IF(RETRO)GO TO 640
32900		JC=M-1
33000		M=KN-1
33100		KN=JC
33200		JC=-1
33300		RETRO=-1.
33400	640	IF(INVRT)GO TO 940
33500	840	X=V(KN)
33600		V(I)=X+VX1
33700	C  FINDS CENTER FOR INVERSION (+TRANSP.)
33800		I=I+1
33900		KN=KN+JC
34000		IF(V(KN-JC).NE.85.)GO TO 940
34100		V(I-1)=85.
34200		GO TO 840
34300	
34400	940	Z=V(KN)
34500		IF(INVRT.EQ.0)GO TO 440
34600		IF(VX1.EQ.0)GO TO 540
34700	C  " @Q N "  WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
34800		IF(CODE.EQ.-33.)GO TO 440
34900		V(I)=Z*VX1
35000		GO TO 7361
35100	440	IF(Z.EQ.85.)GO TO 540
35200		Y=0
35300		IF(INVRT.EQ.0)Y=(X-Z)*2.
35400		V(I)=Z+VX1+Y
35500		GO TO 7361
35600	540	V(I)=Z
35700	7361	I=I+1
35800		KN=KN+JC
35900		IF(KN.NE.M)GO TO 940
36000	
36100		INVRT=-1
36200		RB=V(I-1)
36300		DO 8361 L=JD,LEND
36400		JG=INP(L)
36500	C   PUT IN NOV 25, 72
36600	CCZZZ	IF(JG.EQ.ISEMI)GO TO 93612
36700		KN=L
36800		INP(L)=IBLA
36900		IF(JG.EQ.KSLA)GO TO 9361
37000		IF(JG.EQ.')')IPRN=IPRN+1
37100	CCZZZ8361	IF(JG.EQ.'*')IAMP=-1
37200	8361	IF(JG.EQ.ISEMI)IAMP=-1
37250		MLX=L
37275	C ↑↑↑↑↑↑↑ 6/75
37300		GO TO 93612
37400	9361	MLX=L
37450		IF(L.EQ.LEND)GO TO 93612
37460	C ↑↑↑↑↑↑↑ 6/75
37500	C  FIX THIS & =IBLA BY CHNGING DO LOOP TO 'GO TO' AT 6721,2722
37600		IF(IAMP.NE.0)GO TO 797
37700		IF(QTS)GO TO 1773
37800	C  GO BACK IF NOT END OF LINE
37900	797	JZ=-1
38000	93612	IF(IAMP.EQ.0)GO TO 93611
38100	C   NOV 25, 72
38200		IF(QTS)GO TO 3013
38300		GO TO 2722
38400	C  THESE ARE FOR "LIT" ITEMS
38500	C  *******  DO NOT USE '@-' OR '@$' WITH 'LIT', RLIST OR RNOT****
38600	C  NO $ WITH FUNC.  $ WITH NUMS AND RHY CAN GIVE NEG RESULT -- TRY IT!
38700	CCZZZ93611	IF(JG.EQ.ISEMI)GO TO 7773
38800	93611	IF(KN.EQ.LEND)GO TO 7773
38900		JZ=0
39000		IF(IPRN.NE.0)GO TO 1773
39100	C ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑PICKS UP ' @X)/ ' SITUATION.  22/6/73
39200		GO TO 236
39300	C  LAST TIME FOR QUOTES
39400	
39500	C********↑↑ ↑↑ WAS TO 6017  JUNE 10,71
39600	C   JUMPS TO END STRING OF QUOTES
39700	6361	CONTINUE
39800		GO TO 99
39900	C @@@@@@@@@@@@@@@@@@@@@@@@@@
40000	5361	IF(N.EQ.'$')GO TO 99
40100	C  FOUND $  BUT NO @!
40200		IF(N.NE.ID)GO TO 53611
40300		IF(ISUB.NE.1)GO TO 53611
40400		IF(INP(JD+1).NE.IF)GO TO 236
40500	C  JUMP IF NOT DUTY FACTOR
40600		DF=DF-100.
40700		GO TO 43615
40800	53611	IF(N.NE.ISS)GO TO 53612
40900		IF(INP(JD+1).NE.'U')GO TO 53612
41000		DF=DF-200
41100	C  FOR SUBROUTINE FLAG.  CAN'T CALL SUBR AT SAME TIME AS REP OR X!!!!
41200		GO TO 43615
41300	53612	IF(N.NE.IAA)GO TO 43611
41400	C   FINDS 'ALL'.
41500		IF(INP(JD+1).NE.'L')GO TO 236
41600		ALL=-1.
41700		GO TO 43615
41800	C  TYPE 'ALL' AFTER PARAM NUM TO PUT DATA IN ALL INSTS.
41900	
42000	C  QUAD CALL MUST BE IN 1ST OF 5 PARAMS.  QUAD MUST BE FOLLOWED
42100	C   BY SPC, / OR ;.  OTHER CALLS SUCH AS MOVE,NUM ETC. CAN
42200	C   APPEAR BEFORE  / OR ;, BUT "ALL" MUST! APPEAR 
42300	C   BEFORE! QUAD (IF USED).
42400	C  ADD AN "F" TO QUAD FOR FUNCTIONS, AN "X" FOR X,Y COORDS.
42500	C BASIC QUAD PRODUCES CIRCLES. /DEGS/RADIUS/CENT. X/CENT. Y/
42600	C  QUADX -- /X /Y / (5TH PARAM WILL ALWAYS BE WASTED)
42700	43611	IF(N.NE.'Q')GO TO 4361
42800		IF(INP(JD+1).NE.'U')GO TO 4361
42900		QX=-13.
43000		DO 43612 N=JD,LEND
43100		J=INP(N)
43200		IF(J.EQ.IXX)QX=QX-1.
43300		IF(J.EQ.IF)QX=QX-2.
43400		IF(J.EQ.IBLA)GO TO 236
43500		IF(J.EQ.KSLA)GO TO 236
43600	CCZZZ	IF(J.EQ.IBLA.OR.J.EQ.KSLA.OR.J.EQ.ISEMI.OR.J.EQ.',')GO TO 236
43700	43612	INP(N)=IBLA
43800	4361	IF(N.NE.'I')GO TO 43613
43900		IF(ISUB.NE.4)GO TO 43613
44000	C  'NM INV' MAKES INST NAME, P1 AND P2 INVISIBLE (REPLACES SEG, ETC.)
44100		INVIS(LK)=-1
44200	43615	DO 43614 L=JD,LEND
44300		N=INP(L)
44400	CC	IF(N.EQ.IBLA.OR.N.EQ.KSLA)GO TO 236
44500		IF(N.EQ.IBLA)GO TO 236
44600		IF(N.EQ.ISEMI)GO TO 236
44700	CCZZZ	IF(N.EQ.IBLA.OR.N.EQ.','.OR.N.EQ.ISEMI.OR.N.EQ.KSLA)GO TO 236
44800	43614	INP(L)=IBLA
44900	CC43613	IF(N.NE.KSLA)GO TO 636
45000	43613	IF(N.NE.KSLA)GO TO 1336
45100	CC	JZ=-1
45200		IF(JD.GE.LEND-1)JZ=0
45300	C  SO IT WILL READ NEXT LINE.
45400	CZZZZZZZZZZZZZZZ	INP(JD)=ISEMI
45500		GO TO 336
45600	CCZZZ436	IF(INP(MLX).NE.IBLA)GO TO 336
45700	CCZZZ	MLX=MLX+1
45800	CCZZZ	GO TO 436
45900	CC636	IF(JD.LT.LEND)GO TO 1336
46000	CC	ICON=0
46100	CC	GO TO 77731
46200	CC	GO TO 7773
46300	C  TO CONTINUE ON NEXT LINE.
46400	CCZZZ636	IF(N.NE.ISEMI)GO TO 936
46500	1336	IF(N.NE.ISEMI)GO TO 936
46600		IAMP=-1
46700	CC	IF(ISUB.NE.1)IAMP=-1
46800	336	MLX=JD+1
46900		IF(ISUB.EQ.104)GO TO 104
47000		IF(ISUB.GT.3)GO TO 1899
47100	   	GO TO (101,102,103),ISUB
47200	C             PAR  MOV LIST  OTHERS
47300	CCZZZ936	IF(N.NE.IDOT)GO TO 736
47400	936	IF(N.NE.IDOT)GO TO 136
47500		L=INP(JD+1)
47600		DO 836 KL=1,10
47700	836	IF(L.EQ.IDAT(KL))GO TO 236
47800		IF(CODE.EQ.-22.)INP(JD)=1
47900		GO TO 236
48000	C   CHANGES DOTTED RHYTHMS TO '1'S.
48100	CCZZZ736	IF(N.NE.'*')GO TO 136
48200	CCZZZ	IAMP=-1
48300	CCZZZ	INP(JD)=IBLA
48400	CCZZZ	GO TO 336
48500	136	IF(N.NE.IQT)GO TO 236
48600		DO 1361 K=JD+1,LEND
48700		IF(INP(K).NE.IQT)GO TO 1361
48800		JD=K+1
48900		GO TO 975
49000	C   SKIPS MATERIAL IN QUOTES
49100	1361	CONTINUE
49200		GO TO 99
49300	C   OPEN QUOTES
49400	236	JD=JD+1
49500		IF(JD.LE.LEND)GO TO 975
49600		TYPE 1236
49700		GO TO 99
49800	1236	FORMAT(' NO END MARK')
49900	1899	CALL SCANR
50000	CZZZZZZZ	ML=MLX
50100	CZZZZZZZZZZZZZZZZZZZZZZZZZZ
50200		GO TO(1,2,3,4,5,6),ISUB
     

00100	101	N=INP(ML)
00200		IZ=ML
00300		ML=ML+1
00400		IF(N.EQ.IBLA)GO TO 101
00500	C ⊗⊗⊗⊗⊗ MAY 13,71 @@@@@@@@@@
00600		JA=-1
00700		IF(N.EQ.IPP)GO TO 1
00800		IF(N.EQ.IE)GO TO 2308
00900		IF(N.EQ.'R')CALL RUNIT
01000	C   'RUN' MAY REPLACE 'END' FOR LAST INST.
01100		IF(N.EQ.ID)GO TO 7720
01200		GO TO 99
01300	1	CALL SCANR
01400	 	LPAR=VX1
01500		IJ=LPAR
01600		IF(QX.GE.0)GO TO 5703
01700		IJ=LPAR+4
01800	C  SETS UP PARAM FOR QUAD CALL
01900		V(I)=IJ+LK*10000
02000		V(I+1)=2*ALL
02100	C  TEST "ALL" FEATURE HERE!!!!!!!
02200	C  X=-13(DEGREES),=-14(X,Y),=-15(CIRCLE FUNCTS),=-16(LINE FUNCTS)
02300		V(I+2)=QX
02400		I=I+3
02500		QX=0.
02600	5703	IAMP=0
02700		IF(IJ.LE.NP(LK))GO TO 897
02800		IF(IJ.LT.31)NP(LK)=IJ
02900	897	IF(LPAR.EQ.32)LPAR=1
03000		V(I)=LPAR+LK*10000
03100	C  +1=WDCNT, +2=CODE, +3='NM' CCCCC
03200		IJ=I+1
03300		I=I+4
03400		ITMP=0
03500		CODE=0
03600		NFLG=1
03700		ML=IZ+M
03800	C   RE=REP  R=RHY  L=LIT  M=MOVE  MX=MOVX  N=NOTES  NU=NUM  
03900	C   S--L=SUBL  S--N=SUBN  T=TAP  RT=RTAP  RL=RLIST  RN=RNOTES
04000	C  QU=QUADC  QUX=QUADX 
04100	5702	ML=ML+1
04200	CC	IF(ML.GT.72)GO TO 99
04300		N=INP(ML)
04400		IF(N.EQ.IBLA)GO TO 5702
04500		IF(N.EQ.',')GO TO 5702
04600		NL=INP(ML+1)
04700		JA=-1
04800		ISUB=0
04900		IF(N.EQ.IXX)GO TO 2703
05000		IF(N.EQ.'R')GO TO 6702
05100		IF(N.EQ.IF)GO TO 8702
05200	4005	JA=0
05300		IF(N.EQ.IEN)GO TO 6005
05400		IF(N.EQ.'M')GO TO 703
05500		IF(N.EQ.'L')GO TO 2720
05600		IF(N.EQ.ISS)GO TO 6703
05700		IF(N.EQ.ITT)GO TO 4018
05800		IF(N.EQ.IQT)GO TO 5720
05900		IF(N.EQ.ISEMI)GO TO 2018
06000		IF(N.EQ.IPP)JA=-1
06100	C  FOR ;P5  P3;
06200		CALL SCANR
06300		IF(ISUB.EQ.8)GO TO 8
06400		I=I+JJ
06500		V(IJ+1)=NNUM+DF
06600		IF(JJ.EQ.1)GO TO 4006
06700	C  IF NNUM IS '-2' THEN NOTES ARE PRINTED
06800		IF(NNUM.NE.-2)GO TO 5006
06900		IX=IJ+3
07000		DO 2006 K=2,JJ,3
07100	2006  CALL RANR(VX,K)
07200	C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
07300	5006	IX=IJ+2
07400		DO 6006 K=1,JJ
07500	6006	V(IX+K)=VX(K)
07600		V(IX+JJ-2)=1.
07700	C  ABOVE ENSURES THAT LAST RAND. UNIT REACHES 100% - 5/74 *********
07800		GO TO 3013
07900	4006	IF(JA)VX1=VX1/100.+9999.
08000	C  CHANGES ;P5 P3; TO ;P5 9999.03; ***** CHECK OUT ON OTHER MACHINES!
08100		V(I-1)=VX1
08200		GO TO 3013
08300	6702	IF(NL.EQ.IE)GO TO 2703
08400	C   JUMP IF "REP"
08500		IF(NL.EQ.ITT)GO TO 4018
08600	C   JUMP IF "RTAP"
08700		CODE=-22
08800		IF(NL.EQ.'L')CODE=-46.0
08900	C   JUMP IF "RLIST" (LIST OF RAND SELECTIONS)
09000		IF(NL.NE.IEN)GO TO 1016
09100	C   JUMP IF NOT "RNOTES"
09200		JA=0
09300	C   FOR SCANR
09400		CODE=-36.
09500		GO TO 1016
09600	6005	CODE=-33
09700		IF(NL.NE.'U')GO TO 1016
09800		CODE=-44.
09900	1610	JA=-1
10000		GO TO 1016
10100	8702	CODE=-35
10200		IF(NL.EQ.'U')GO TO 1016
10300		ML=ML+1
10400		CALL SCANR
10500	7	V(IJ+1)=CODE+DF
10600		V(IJ+2)=1.
10700		IF(VX1.GT.15)GO TO 99
10800	C TRAPS F NUMS >15.
10900		V(I)=VX1+85.
11000		GO TO 7703
11100	C********  MOVE IS NEXT ***********
11200	703	BW=V(IJ-2)
11300		IC=0
11400	CC	DO 7031 K=ML+1,72
11500		DO 7031 K=ML+1,LEND
11600		IF(INP(K).EQ.KSLA)GO TO 8031
11700	CC	IF(INP(K).EQ.ISEMI)GO TO 8031
11800	7031	IF(INP(K).EQ.IXX)IC=-1
11900	C   IC=-1 IS FOR MOVX
12000	8031	I=I-1
12100		V(I)=0
12200		X=-9900.-BY
12300		IF(BY.EQ.0)X=-9900.-BG(LK)
12400	   	IF(BW.EQ.X)GO TO 8005
12500		IF(BW.NE.-9900.-BY)GO TO 1102
12600		V(IJ-2)=X
12700		GO TO 8005
12800	1102	V(IJ)=V(IJ-1)
12900		V(IJ-1)=X
13000		IJ=IJ+1
13100		I=I+1
13200	8005	LP=IJ-1
13300		BW=-9900.-X
13400		ISUB=2
13500		IZ=-1
13600	C  ABOVE ARRANGES NECESSARY BG TIME HEADINGS.
13700	4703	GO TO 1299
13800	102	IF(IZ.LT.0)GO TO 2102
13900	C  SKIPS NEXT FIRST TIME
14000		BW=V(ICT)+BW
14100		V(I)=-9900.-BW
14200		V(I+1)=V(LP)
14300		V(I+2)=(JJ+2)*ALL
14400		V(I+3)=CODE+DF
14500		I=I+4
14600		IZ=1
14700	2102	IF(BW.LT.10000.)CALL BGSORT(BW)
14800	C   ROUND-OFF NONSENSE
14900	2	VX3=-9900.
15000		VX2=VX3 
15100		CALL SCANR
15200		IF(JJ.GT.0)GO TO 5102
15300		JJ=ILIT
15400	C SLASH WILL REPEAT MOVE INPUT -- 6/74
15500		DO 6102 K=1,JJ
15600	6102	VX(K)=VX(K+20)
15700		GO TO 5005
15800	C::::::::::::::: PUT THIS, AND AT 5505, IN SCOR5 ALSO ::::::::::::::
15900	5102	IF(JJ.EQ.4)GO TO 99
16000	C  ERROR -- 4 ITEMS IN MOVE IMPOSSIBLE
16100		IF(VX3.NE.-9900.)GO TO 3102
16200		IF(VX2.NE.-9900.)GO TO 4102
16300		VX2=VX1
16400		VX1=10000.
16500	4102	VX3=VX2
16600		JJ=3
16700	C  1,2 OR 3 NUMS CAN BE USED IN NON-RAN MOVES.
16800	3102	IF(IZ.GE.0)GO TO 3006
16900		V(IJ)=(JJ+2)*ALL
17000	C  WORD COUNT
17100		CODE=-55.
17200		IF(JJ.NE.3)CODE=-57.
17300		IF(NFLG)CODE=CODE-1.
17400		IF(IC)CODE=-59.
17500	C  CODE=-56 OR -58 FOR NOTES.
17600		V(IJ+1)=CODE+DF
17700		IZ=0
17800	3006	IF(NFLG.EQ.1)GO TO 5005
17900	      CALL RANR(VX,2)
18000	      IF(JJ.NE.3)CALL RANR(VX,4)
18100	C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
18200	5005	ICT=I
18300		ILIT=JJ
18400	C  SAVES FOR SLASH REPEAT FEATURE
18500	  	IJ=IJ+1
18600		DO 1006 K=1,JJ
18700		VX(20+K)=VX(K)
18800	C  SAVES FOR SLASH REPEAT FEATURE
18900	1006	V(IJ+K)=VX(K)
19000		I=I+JJ  
19100		IJ=I+2
19200		IF(IAMP.EQ.0)GO TO 1299
19300	C*************** MAY 18,71 ***** ALWAYS RESETS TO TIME 0 WHEN MOVE IS USED.
19400		V(I)=-9900.-BY
19500		GO TO 8703
19600	
19700	7703	V(IJ)=4.*ALL
19800	8703	I=I+1
19900		GO TO 4773
20000	C   FOR SUBROUTINES, -12=NUMS.  -11=LETTERS.
20100	6703	CODE=-12.
20200		IF(INP(ML+3).EQ.'L')CODE=-11.
20300		V(IJ)=2.*ALL
20400		V(IJ+1)=CODE+DF
20500		I=I-1
20600		GO TO 4773
20700	4018	CNT(LK)=-9900.-BY
20800		P(LK)=V(I-4)
20900	CC 6/74 COLGATE 	JREAD=3
21000	CC 6/74 COLGATE	GO TO 4400
21100	1444	IF(READER(JNP))CALL RUNIT
21200	C  READS A LINE.  IF END OF FILE, JUMPS.
21300	443	IF(LN.NE.0)REREAD 107,K,IPT(LK,1)
21400		IF(LN.EQ.0)REREAD 8001,IPT(LK,1)
21500	C   NAME OF RHYTHM FILE. (ONLY ONE PER INST.)  READS DATA JUST BEFORE RUN
21600		IF(J.EQ.'CONDU')GO TO 444
21700		IF(NL.NE.ITT)GO TO 2338
21800		CODE=-23.
21900		GO  TO 1016
22000	2338	I=I-4
22100		GO TO 4773
22200	3018	CNT(KZY)=-9900.
22300		GO TO 1444
22400	444	P(KZY)=980000.
22500		GO TO 2308
22600	C   CAN'T USE 'TAP' OR 'RTAP' WITH INST KZY IF USING 'CONDUCT'.
22700	C  'REP'
22800	2703	ML=ML+1
22900		VX1=0
23000		VX2=0
23100		VX3=0
23200		IF(N.EQ.IXX)GO TO 2704
23300		INP(ML)=IBLA
23400		INP(ML+1)=IBLA
23500	C  WIPES OUT 'EP' IN 'REP'
23600	2704	CALL SCANR
23700	 	V(IJ)=3.
23800		V(IJ+1)=-66.0
23900		IF(VX1.EQ.32.)VX1=1.
24000		IF(VX1.EQ.0)VX1=LPAR
24100		IF(VX2.EQ.0)VX2=LK-1
24200		V(IJ+2)=VX1+VX2*10000.
24300		KL=VX2
24400		IF(DUR(LK).LT.0)DUR(LK)=DUR(KL)
24500		IF(VX3.EQ.0)GO TO 4773
24600		L=VX3
24700		ML=LK+1
24800		DO 1018 KL=ML,L
24900		IF(LPAR.LE.NP(KL))GO TO 997
25000		IF(LPAR.LT.31)NP(KL)=LPAR
25100	997	IF(DUR(KL))DUR(KL)=DUR(LK)
25200	C  TO SET DUR WHEN DUPLICATING NOTES THAT END WITH 'END;;'
25300		V(I)=V(I-4)+10000.
25400		V(I+1)=3.
25500		V(I+2)=-66.
25600		V(I+3)=V(I-1)
25700	1018	I=I+4
25800		GO TO 4773
25900	
26000	2018	IF(DF.EQ.0)GO TO 20181
26100	C NEXT FOR Pn SUBR/ I.E. NOTHING BUT P AND SUB CALL. 7/73
26200		V(IJ+1)=-201.
26300		V(IJ+2)=1.
26400		V(IJ+3)=0
26500		GO TO 7703
26600	20181	V(IJ)=3.
26700		V(IJ+1)=-66.
26800		V(IJ+2)=NW+LK*10000
26900		GO TO 4773
27000	C  READS /P5  .3 "ABC" .7 "XYZ"/
27100	
27200	8 	V(IJ+1)=-77.+DF
27300	C  DF HAS SUBR CALL INFO
27400		I=I+1
27500		VX(JJ-1)=1
27600	C  FOR RAND. SINGLE LITS.
27700		DO 3722 K=1,JJ,2
27800		V(I)=VX(K)
27900	3722	I=I+1
28000		V(IJ+2)=JJ/2
28100		V(IJ+3)=I
28200		DO 4722 K=2,JJ,2
28300		KN=I
28400		I=I+1
28500		L=VX(K)
28600		DO 6722 KL=L,LEND
28700		IF(INP(KL).EQ.IQT)GO TO 4722
28800		IV(I)=INP(KL)
28900	6722	I=I+1
29000	4722	V(KN)=I-KN-1
29100		V(IJ)=(I-IJ)*ALL
29200		GO TO 4773
29300	2720	QTS=0
29400		ISUB=104
29500		GO TO 1299
29600	
29700	104	DO 6721 K=ML,LEND
29800		JC=K+1
29900		IF(INP(K).EQ.IQT)GO TO 7721
30000	6721	IF(INP(K).EQ.KSLA)GO TO 7232
30100		IF(INP(K).EQ.ISEMI)GO TO 7232
30200	C  FOR REPEAT OF ITEM BY SLASH
30300	CC7232	DO 7231 K=I-1,1,-1
30400	CC CHNGD 6/74	IF(ABS(V(K)).GT.72.)GO TO 7231
30500	CC	NL=V(K)
30600	CC	DO 7230 KL=K,K+NL
30700	7232	DO 7230 KL=ILIT,ILIT+NLIT
30800		V(I)=V(KL)
30900	7230	I=I+1
31000		GO TO 27222
31100	7231	CONTINUE
31200	
31300	5720	IAMP=-1
31400		JC=ML+1
31500	C  FOR SINGLE 'LIT' ITEMS.
31600	7721	DO 1722 KL=JC+1,LEND
31700		IF(INP(KL).NE.IQT)GO TO 1722
31800		JD=KL-1
31900		ML=KL+1
32000		NLIT=KL-JC
32100	C   EXTENT OF LIT ITEM IS FOUND
32200		GO TO 8721
32300	1722	CONTINUE
32400	C  CAN'T USE SLASH FOR REPEAT AFTER @Q
32500	8721	V(I)=NLIT
32600		ILIT=I
32700		DO 9721 K=JC,JD
32800	C   PUTS ITEM IN "IV" ARRAY
32900		I=I+1
33000	9721	IV(I)=INP(K)
33100		I=I+1
33200	27222	IF(IAMP.EQ.0)GO TO 1299
33300	2722	V(I)=999.
33400		QTS=-1.
33500	27221	V(IJ+1)=-88.+DF
33600		V(IJ)=(I-IJ+1)*ALL
33700		IJ=IJ+2
33800		V(IJ)=IJ+1
33900		I=I+1
34000		ISUB=1
34100		GO TO 1299
34200	
34300	7720	V(I)=LK
34400		V(I+1)=3.
34500		V(I+2)=-67.
34600		ML=ML+4
34700		CALL SCANR
34800	 	V(I+3)=VX1
34900		I=I+4
35000		L=VX1
35100		IF(NP(LK).LT.NP(L))NP(LK)=NP(L)
35200		IF(DUR(LK).LT.0)DUR(LK)=DUR(L)
35300		GO TO 4773
35400	C   TYPE 'DUPL N;'   N=INST # TO BE DUPLICATED.
35500	142	FORMAT(I,15A5) 
35600	1301	FORMAT(15A5) 
35700	CCC2773	FORMAT(I,A5,72A1) 
35800	CC2114  FORMAT(I,80A1)
35900	300	FORMAT(I,3F,A1)
36000	301	FORMAT(3F,A1)
36100	6 	KB=KB+1
36200		IF(JED.GT.0)JED=0
36300		IF(J.EQ.'INSER')GO TO 1340
36400	      OTH(KB,1)=VX1*100000.+VX2*100.+VX3   
36500	      GO TO 340   
36600	1340	X=VX1
36700		IF(VX2.NE.0)X=1000000.+VX1*100000.+VX2    
36800		OTH(KB,1)=X
36900		GO TO 1338
37000	C   ABOVE IS TO PUT INSERT AFTER NOTE # OF A PARTICULAR
37100	C   INSTRUMENT.  FOR COMMENT AT START, SET BG TIME TO 1,1 
37200	C   - BEGIN LINE WITH  <,END WITH ; 
37300	C   UP TO 75 CHARACTERS MAY BE TYPED.     
37400	340      IF(VX3.NE.2)GO TO 1338 
37500		IF(ITYP.GE.0)GO TO 449
37600	CC	JREAD=5
37700	CC 6/74  COLGATE	GO TO 4400
37800		IF(READER(JNP))CALL RUNIT
37900	C  READS A LINE.  IF END OF FILE, JUMPS.
38000	445	OTH(KB,3)=1.
38100		IF(LN.EQ.0)GO TO 447
38200		REREAD 300,K,OTH(KB,2)
38300		GO TO 1447
38400	447	REREAD 301,OTH(KB,2)
38500	1447	IF(JED)GO TO 2308
38600	3445	TYPE TEDIT
38700		ACCEPT 77732,K
38800		IF(K.EQ.IG)JED=-1
38900		IF(J.EQ.'INSER')GO TO 3446
39000		IF(K.NE.'Y')GO TO 2308
39100		IF(JED)GO TO 2308
39200	449	TYPE TPALN
39300		ACCEPT 301,OTH(KB,2)
39400		IF(JED)WRITE(21,301) OTH(KB,2)
39500		GO TO 2308
39600	
39700	1338	IF(ITYP.GE.0)GO TO 1449
39800	CC	JREAD=6
39900	CC 6/74 COLGATE	GO TO 4400
40000		IF(READER(JNP))CALL RUNIT
40100	C  READS A LINE.  IF END OF FILE, JUMPS.
40200	446	IF(LN.EQ.0)GO TO 448
40300		REREAD 142,K,(OTH(KB,JD),JD=2,16)    
40400		GO TO 1446
40500	448	REREAD 1301,(OTH(KB,JD),JD=2,16)    
40600	1446	IF(JED)2446,3445,2446
40700	3446	IF(K.NE.'Y')GO TO 2446
40800		IF(JED)GO TO 2446
40900	1449	TYPE TPALN
41000		ACCEPT 1301,(OTH(KB,JD),JD=2,16)
41100		IF(JED)WRITE(21,1301)(OTH(KB,JD),JD=2,16)
41200	2446	X=OTH(KB,2)
41300		IF(J.NE.'INSER')GO TO 971
41400		IF(VX3.EQ.0)GO TO 971
41500		IF(X.NE.'*')GO TO 6
41600	971	IF(X.EQ.'*')KB=KB-1
41700	C   ALLOWS SEVERAL LINES OF 'INSERT' IF ANY 3RD #.
41800	C   LAST LINE HAS '*' IN COLUMN 1.
41900		GO TO 2308
42000	C   IF NO PARAM NUM IS GIVEN, ALL PARAMS MUST BE TYPED.
42100	C   INSERT MAY INCLUDE 10 CHARS(P3-P30),
42200	C   P2, A # ONLY.  IF MORE THAN 1 PARAM IS TO BE EDITED AND
42300	C   P2 IS ONE OF THEM, FIRST EDIT P2 TO DESIRED VALUE,
42400	C   CHANGE P2 TO MINUS = THEN INSERT ENTIRE NOTE TO PLAY
42500	C   JUST AFTER ORIGINAL NOTE(WHICH WILL BE A REST).
42600	C   BX=INST N. Y=NOTE N. Z=PARAM N. 
     

00100	1106	KTMP=1
00200		TP=60.
00300		IAMP=0
00400		BW=BY
00500		ITMP=-1
00600		ISUB=5
00700		JA=-1
00800		GO TO 2016
00900	3019	V(I)=990000.00
01000		V(I+1)=4.
01100		V(I+2)=VX1
01200		V(I+3)=VX2/TP
01300		V(I+4)=VX3/TP
01400		I=I+5
01500		BY=BW
01600	C  SEPT 18, 70
01700		IF(VX1.EQ.0)GO TO 2308
01800		BW=BW+VX1
01900		V(I)=-9900.-BW
02000		I=I+1
02100		CALL BGSORT(BW)
02200	9003	IF(IAMP)GO TO 4003
02300	2016	VX3=0
02400		VX2=0
02500		GO TO 1299
02600	5	IF(VX2.NE.0)GO TO 105
02700	C  'TEMPO/120;'  OR  'TEMPO/1.5 72;'  IS OK.
02800		VX2=VX1
02900		VX1=0
03000	105	IF(VX3.EQ.0)VX3=VX2
03100		IF(VX2.LT.11.)TP=1.
03200		IF(J.EQ.ITMPO)GO TO 3019
03300	  	PCH(1,KTMP)=VX1
03400		PCH(2,KTMP)=VX2
03500		PCH(3,KTMP)=VX3
03600	C   PCH(1)=TIME  (2)=MM1  (3)=MM2
03700		KTMP=KTMP+1
03800		IF(IAMP.EQ.0)GO TO 2016
03900	4003	VX1=0
04000		IAMP=0
04100		VX2=VX3
04200		IF(J.EQ.ITMPO)GO TO 3019
04300		PCH(1,KTMP)=0
04400		PCH(2,KTMP)=VX2
04500		PCH(3,KTMP)=VX2
04600	C   MM CAN BE FROM 11 UP  TEMPO FACTOR FROM 10 DOWN.  
04700	C   UP TO 30 TEMPO CHANGES MAY BE MADE.   
04800	
04900	1016      IA=I    
05000	      IZ=1  
05100	3100	V(I-2)=CODE+DF
05200	      ISUB=3     
05300	5016	IF(IAMP.GE.0)GO TO 1299
05400	117	IF(IZ-2)3013,9004,9004
05500	103	K=INP(ML)
05600		IF(K.EQ.ITT)GO TO 1106
05700		IF(K.EQ.KSLA)GO TO 1014
05800		IF(K.EQ.ISEMI)GO TO 1014
05900	CZZZZZZZZZZZZ  CC  ZZZZZZZZZZZZ
06000		IF(K.NE.IBLA) GO TO 1899
06100		ML=ML+1
06200		GO TO 103
06300	3      IF(VX1.EQ.-99.)GO TO 4022
06400		IF(CODE.EQ.-22.)GO TO 2017
06500	  	IF(CODE.LT.-23)GO TO 17
06600		IF(IZ/2*2.EQ.IZ)GO TO 17
06700	C    CHECKS PAIRS OF NUMBERS FOR 'RTAP'
06800	2017	IF(VX1.EQ.10000.)GO TO 17
06900	      VX1=4./VX1
07000		IF(JJ.NE.1)GO TO 2014
07100		V(I)=VX1
07200		GO TO 114
07300	
07400	1217	IF(VX1.EQ.10000.)GO TO 114
07500	C    FOR "FINE" IN LIST
07600	      V(I+1)=VX2
07700	      IF(CODE.EQ.-36.)CALL RANR(V,I)
07800	2217	I=I+1
07900	C  SETS UP STRING OF RAND SELECTIONS
08000		GO TO 114
08100	3217	V(I)=V(I-2)
08200		V(I+1)=RB
08300	C  FOR SLASH REPTS OF RAND SELEC UNITS. ("REP" CAN'T BE USED!)
08400		GO TO 2217
08500	C******** PUT IN ERROR TRAP FOR "REP" ETC. ******
08600	
08700	2014	DO 9006 L=2,JJ
08800		IF(VX(L).EQ.0)GO TO 17
08900	9006	VX1=4./VX(L)+VX1
09000		JJ=1
09100	17	V(I)=VX1
09200		IF(CODE.EQ.-46.)GO TO 1217
09300		IF(CODE.EQ.-36.)GO TO 1217
09400		IF(CODE.NE.-35)GO TO 972
09500		IF(VX1.GT.15)GO TO 99
09600	C  FINDS F NUM.>15!
09700	C  JUMP IF STRING OF RAND SELECS.
09800	972	IF(JJ.EQ.1)GO TO 114
09900		L=VX(JJ)-1
10000		X=V(I)
10100		NL=I+1
10200		I=L+I
10300		DO 1017 K=NL,I
10400	1017	V(K)=X
10500	C   ADDS UP TOTAL   OF NOTES IN SEQ.
10600		IZ=IZ+L
10700		GO TO 114
10800	1014	IF(CODE.EQ.-46.)GO TO 3217
10900		IF(CODE.EQ.-36.)GO TO 3217
11000		V(I)=RB
11100	C   RB SAVES IT FOR SLASH REPEAT
11200	114      RB=V(I)     
11300	      I=I+1 
11400	      IZ=IZ+1     
11500	      GO TO 5016    
11600	4022      JC=VX2+.3
11700	      JD=VX3-.5
11800		IF(JJ.EQ.2)JD=1
11900	C********* MAY 19,71   ----MANY LINES ABOVE.
12000	      IZ=IZ+JC*JD 
12100	C   JC=HOW MANY TIMES,  JD=HOW MANY NOTES 
12200	      DO 1005 K=1,JD    
12300	       NL=I+JC-1  
12400	      DO 2005 L=I,NL    
12500	2005  V(L)=V(L-JC)
12600	1005      I=I+JC  
12700		RB=V(NL)
12800	C  RB SAVES DATA FOR SLASH REPEAT FEATURE.
12900	      GO TO 5016  
13000	
13100	9004	IF(ITMP.EQ.0)GO TO 3013
13200		IZ=IZ-1
13300	C***** JAN. 1974
13400	      KA=1  
13500	      IC=1  
13600	      K=0   
13700		J=1
13800	      Z=0   
13900	      RC=0  
14000	9007	Y=PCH(3,IC)/TP
14100		X=PCH(2,IC)/TP
14200	      Z=PCH(1,IC) 
14300		CALL SQYY(YY,X,Y,Z)
14400		XT(1)=X
14500	      PR=RA 
14600	C75      RD=1  
14700	C75      RB=0  
14800	      ZZ=Z  
14900	      CALL ACCEL
15000	      IF(K.EQ.IZ)GO TO 3013
15100		IF(RA.NE.10000.)GO TO 9007     
15200	C********* MAY 13,71  OMITS REPEATED RHY. FEATURE.
15300	3013	X=I-IJ
15400		V(IJ+2)=X-3.
15500		V(IJ)=X*ALL
15600		IF(CODE.NE.-35)GO TO 4773
15700		M=IJ+3
15800	C   SETS NUMBERS FOR FUNCS.
15900		DO 313 K=M,I-1
16000	313	IF(V(K).LT.85.)V(K)=V(K)+85.
16100		GO TO 4773
16200	
16300		END